home *** CD-ROM | disk | FTP | other *** search
/ Mac100% 1998 November / MAC100-1998-11.ISO.7z / MAC100-1998-11.ISO / オンラインソフト定点観測 / ユーティリティ / Mops 3.2.sea / Mops 3.2 / Mops source / PPC source / cg4 < prev    next >
Text File  |  1998-06-11  |  16KB  |  719 lines

  1. marker m__cg4
  2.  
  3.  
  4. (*        =========================================================
  5.                           PEF file generation
  6.         =========================================================
  7.         
  8. This file handles the writing out of a PEF object file for our compiled
  9. PPC code.
  10. *)
  11.  
  12. PPC?
  13. [IF]
  14.   endload
  15. [THEN]            ¥ in PPC mode we load this code in the zPEF file.  This
  16.                 ¥  way, objects get their classinit: etc, and things are
  17.                 ¥  generally less complicated.
  18.  
  19.  
  20.     0    constant    _Z
  21.  
  22. : NULLOSSTR        ['] _z  ;
  23.  
  24.  
  25. 0    value    CONTAINER_OFFS
  26.  
  27. 0    value    CODE_SIZE
  28. 0    value    CODE_OFFS
  29.  
  30. 0    value    DATA_SIZE
  31. 0    value    DATA_OFFS
  32.  
  33. 0    value    LDR_SIZE
  34. 0    value    LDR_OFFS
  35.  
  36. 64    constant    INFO_BLOCK_SIZE        ¥ a block of useful info we put at the
  37.                                     ¥  start of the code section so our PPC
  38.                                     ¥  code can pick it up easily.
  39.  
  40.  
  41. ¥        =============  resource stuff ===============
  42.  
  43. ¥ (mainly lifted from InstlMod.txt)
  44.  
  45.  
  46. syscall ResError
  47. syscall ChangedResource
  48. syscall AddResource
  49.  
  50. : CHK
  51.     ResError  ?dup
  52.     IF  3 beep  3 beep
  53.         cr ." Res error# " .  cr  QUIT
  54.     THEN  ;
  55.  
  56.  
  57. ¥ Class RES+ adds methods to Resource to allow various modifications
  58. ¥ to resources.  We'll put more in as we need them.
  59.  
  60. :class    RES+    super{ resource }
  61.  
  62. objPtr    TEMPRES  class_is  res+
  63.  
  64. :m CHANGED:    get: self  ChangedResource  ;m
  65.  
  66. :m ADDRES:  { s255 -- }
  67.     get: self
  68.     get: resType  get: ID
  69.     s255  AddResource  chk  ;m
  70.  
  71. ;class
  72.  
  73.  
  74. res+    srcres
  75. res+    dstres
  76.  
  77. : COPYRES    ¥ ( type resID -- )  Copies the resource by copying
  78.             ¥  the handle's data in memory.  Use this one for resources
  79.             ¥  currently in use.
  80.             
  81.     2dup  set: srcRes  set: dstRes
  82.     getnew: srcRes  chk  srcRes ->: dstRes
  83.     nullOSstr  addRes: dstRes  chk  ;
  84.  
  85.  
  86. ¥        ===============================================================
  87.  
  88.  
  89. :class  SECTION_HEADER  super{ object }
  90. record
  91. {    var        sectionName
  92.     var        sectionAddress
  93.     var        execSize
  94.     var        initSize
  95.     var        rawSize
  96.     var        containerOffset
  97.     ubyte    regionKind
  98.     ubyte    alignment
  99.     ubyte    shareKind
  100.     ubyte    reserved
  101. }
  102.  
  103. :m CLASSINIT:
  104.     -1 put: sectionName  ;m        ¥ means no name
  105.     
  106. :m >SIZE:
  107.     dup put: execSize  dup put: initSize  put: rawSize
  108.     get: regionKind 4 =            ¥ loader section?
  109.     IF    clear: execSize
  110.         clear: initSize
  111.     THEN
  112. ;m
  113.  
  114. :m >KIND: { kind -- }
  115.     kind  put: regionKind
  116.     kind 1 =  kind 2 = or
  117.     IF                        ¥ data or PIdata
  118.             1                ¥ contextShare
  119.     ELSE    4                ¥ globalShare
  120.     THEN
  121.     put: shareKind
  122.     4 put: alignment
  123. ;m
  124.  
  125. :m >OFFSET:        put: containerOffset  ;m
  126.  
  127. :m INIT:    ¥ ( offset size -- )
  128.     >size: self  put: containerOffset  ;m
  129.  
  130. ;class
  131.  
  132. ¥        ================== loader section stuff ===================
  133.  
  134. :class  LOADER_HEADER_CLASS  super{ object }
  135. record
  136. {    var        entryPointSection
  137.     var        entryPointOffset
  138.     var        initPointSection
  139.     var        initPointOffset
  140.     var        termPointSection
  141.     var        termPointOffset
  142.     var        numImportFiles
  143.     var        numImportSyms
  144.     var        numSections            ¥ number of relocation headers
  145.     var        relocationsOffset
  146.     var        stringsOffset
  147.     var        hashSlotTable
  148.     var        hashSlotTabSize
  149.     var        numExportSyms
  150. }
  151.  
  152. :m INIT:  { relocTblOffs stringsOffs hashSlotTblOffs entrySect #imports -- }
  153.     relocTblOffs    put: relocationsOffset
  154.     stringsOffs        put: stringsOffset
  155.     hashSlotTblOffs    put: hashSlotTable
  156.     entrySect        put: entryPointSection
  157.     #imports        put: numImportSyms
  158.     #imports 4*            ¥ offset to just after imported symbols in the
  159.                         ¥ TOC - this will be the entry funct descriptor
  160.                     put: entryPointOffset
  161. ;m
  162.  
  163. :m CLASSINIT:
  164.     1 put: entryPointSection        ¥ need to use -1 for library PEFs
  165.     -1 put: initPointSection
  166.     -1 put: termPointSection
  167.     1 put: numImportFiles            ¥ should only be 1 ("InterfaceLib") for
  168.                                     ¥  Mops PEFs
  169.     1 put: numSections                ¥ Only 1 loader relocation header
  170. ;m
  171.     
  172.     
  173. ;class
  174.  
  175.  
  176. :class  IMP_FILES_SUBSEC_CLASS  super{ object }
  177. record
  178. {    var        fileName
  179.     var        oldDefVersion
  180.     var        currentVersion
  181.     var        numImports
  182.     var        impFirst
  183.     ubyte    initBefore
  184.     ubyte    reservedB
  185.     uint    reservedH
  186. }
  187.  
  188. :m >numImports:        put: numImports  ;m
  189.  
  190. ;class
  191.  
  192.  
  193. :class  PEF_HEADER_CLASS  super{ object }
  194. record
  195. {    var        joy
  196.     var        fileTypeID
  197.     var        architectureID
  198.     var        versionNumber
  199.     var        dateTimeStamp
  200.     var        definVersion
  201.     var        implVersion
  202.     var        currentVersion
  203.     uint    numberSections
  204.     uint    loadableSections
  205.     var        memoryAddress
  206. }
  207.  
  208. :m CLASSINIT:
  209.     'type    Joy!  put: joy
  210.     'type    peff  put: fileTypeID
  211.     'type    pwpc  put: architectureID
  212.     1  put: versionNumber
  213.     3  put: numberSections
  214.     2  put: loadableSections
  215. ;m
  216.  
  217. :m SETTIMESTAMP:
  218. ¥    $ 20C @                        ¥ ### fix after I can handle fetch from a
  219.                                 ¥  literal address!
  220.     0  put: dateTimeStamp  ;m
  221.  
  222. ;class
  223.  
  224. :class    cfrg_ClASS  super{ object }
  225. record
  226. {    var        res0
  227.     var        res1
  228.     var        cfrgVersion
  229.     var        res2
  230.     var        res3
  231.     var        res4
  232.     var        res5
  233.     var        #fragDescs
  234.     
  235. ¥ now the (only) fragment description:
  236.     var        CodeType
  237.     var        UpdateLevel
  238.     var        CurrentVersion
  239.     var        OldestDevVersion
  240.     var        AppStackSize
  241.     uint    AppLibDirectory
  242.     ubyte    TypeOfFragment
  243.     ubyte    LocationOfFragment
  244.     var        OffsetToFragment
  245.     var        LengthOfFragment
  246.     var        res6
  247.     var        res7
  248. }
  249.  
  250. :m CLASSINIT:
  251.     1 put: cfrgVersion
  252.     1 put: #fragDescs
  253.     'type pwpc  put: codeType
  254.     1 put: TypeOfFragment
  255.     1 put: LocationOfFragment
  256. ¥ everything else except LenOfInfoRec stays zero.
  257. ;m
  258.  
  259. ;class
  260.  
  261.  
  262. ¥ PPC?
  263. ¥ [IF]
  264. ¥
  265. ¥ endload                ¥ let's get files working first!
  266. ¥
  267. ¥ [THEN]
  268.  
  269.  
  270.     cfrg_class                my_cfrg
  271.  
  272.     PEF_header_class        PEF_header
  273.     section_header            CODE_SECT_HDR
  274.     section_header            DATA_SECT_HDR
  275.     section_header            LOADER_SECT_HDR
  276.  
  277.     loader_header_class        LOADER_HEADER
  278.  
  279. ¥ we only have one import file - for more, we'd need to have more
  280. ¥  than one imp_files_subsec_class object.  But note, there's only
  281. ¥  one import symbol table per PEF.
  282.  
  283.     imp_files_subsec_class    IMPORT_FILES_SUBSECTION
  284.     
  285.     bytestring                LDR_IMPORT_SYM_TBL
  286.     bytestring                RELOCS
  287.     bytestring                LOADER_STRINGS
  288.     bytestring                $cfrg
  289.     bytestring                $threads
  290.  
  291.     file                    OUTPF
  292.  
  293.  
  294. : CREATE_OUTPF?        ¥ ( -- b )
  295.     clear: outpf
  296.     " PMops" name: outpf
  297.     open: outpf NIF  close: outpf drop  delete: outpf drop  THEN
  298.     create: outpf  OK?
  299.     'type APPL  'type Mopp  set: outpf
  300.     $ 21  addr: outpf  $ 28 + c!            ¥ Set Bundle bit
  301.     setFileInfo: outpf  OK?
  302.  
  303.     true  ;
  304.  
  305.  
  306. variable PAD_BYTES
  307. 16 PPC? [IF] reservex +echox [ELSE] reserve [THEN]    ¥ ensure we pad with zeros
  308. ¥ 16 reserve
  309.  
  310. : ALIGN_IN_CONTAINER  { alignment# ¥ pad# -- }
  311.     alignment#  container_offs  alignment# 1- and  -
  312.     alignment# 1-  and  -> pad#
  313.     pad#  0EXIT
  314.     pad_bytes pad#  write: outpf  OK?
  315.     pad# ++> container_offs
  316. ;
  317.  
  318. : WRITE_TO_CONTAINER  { addr len ¥ pad# -- }
  319.     4  align_in_container
  320.     addr len write: outpf  OK?
  321.     len ++> container_offs
  322. ;
  323.  
  324.  
  325. : WRITE_OBJ  { ^obj ¥ len -- }
  326.     length: [ ^obj ]  -> len
  327.     ^obj len  write_to_container
  328. ;
  329.  
  330. 0    value    IMP_SYM_CNT
  331.  
  332. : ADD_IMPORT_SYMBOL        ¥ ( addr len -- )  symbol name is passed in.
  333.     pos: loader_strings
  334.     $ 02000000 or                ¥ means it's in the code section
  335.     +L: ldr_import_sym_tbl
  336.     add: loader_strings  0 +: loader_strings
  337.     1 ++> imp_sym_cnt  ;
  338.  
  339.  
  340. 23    constant    #IMPORTED_SYMBOLS
  341.                     ¥ We define this as a constant since we need it at
  342.                     ¥  compile time.  In init_import_sym_tbl below, called
  343.                     ¥  at write_PEF time, we check that the real number of
  344.                     ¥  imported symbols agrees, and bail out if it doesn't.
  345.                     ¥  That avoids nasty crashes.
  346.  
  347.  
  348. ¥ Note the symbols we list here are CASE-SENSITIVE!!  The PEF will fail at startup
  349. ¥  time if something doesn't resolve, and case matters!
  350.  
  351.  
  352. : INIT_IMPORT_SYM_TBL
  353.     0 -> imp_sym_cnt
  354.     " InterfaceLib"  add: loader_strings  0 +: loader_strings
  355.  
  356.     " GetSharedLibrary"            add_import_symbol
  357.     " FindSymbol"                add_import_symbol
  358.     " Debugger"                    add_import_symbol
  359.     " NewHandleClear"            add_import_symbol
  360.     " NewPtrClear"                add_import_symbol
  361.     " MoveHHi"                    add_import_symbol
  362.     " HLock"                    add_import_symbol
  363.     " MakeDataExecutable"        add_import_symbol
  364.     " BlockMove"                add_import_symbol
  365.     " ExitToShell"                add_import_symbol
  366.     " InitGraf"                    add_import_symbol
  367.     " InitFonts"                add_import_symbol
  368.     " InitWindows"                add_import_symbol
  369.     " TEInit"                    add_import_symbol
  370.     " InitMenus"                add_import_symbol
  371.     " InitCursor"                add_import_symbol
  372.     " AEInstallEventHandler"    add_import_symbol
  373.     " GetNewWindow"                add_import_symbol
  374.     " SetPort"                    add_import_symbol
  375.     " NewRgn"                    add_import_symbol
  376.     " TextMode"                    add_import_symbol
  377.     " SysBeep"                    add_import_symbol
  378.     " MaxApplZone"                add_import_symbol
  379.  
  380. ¥ add any more we need here.
  381.  
  382.     imp_sym_cnt #imported_symbols <>  abort" wrong number of imported symbols"
  383.     #imported_symbols >numImports: import_files_subsection
  384. ;
  385.  
  386.  
  387. #imported_symbols 4*
  388.         constant    ENTRY_POINT_TOC_OFFSET
  389.                             ¥ our entry point func descriptor comes straight after
  390.                             ¥  the imported symbols, which are 4 bytes each
  391.  
  392. : TOC_SIZE    ¥ ( -- n )    4 bytes for each imported symbol, plus 12 for
  393.                     ¥    our entry point function descriptor
  394.     entry_point_toc_offset  12 +
  395. ;
  396.  
  397.  
  398.  
  399. ¥ Here we define some words so we can easily make a call to one of these
  400. ¥  symbols.  We do it here so we can be sure that the TOC offsets are
  401. ¥  right - these are determined by the above order.
  402.  
  403.  
  404. forward (TOC_CALL)
  405.  
  406. 0    value    curr_TOC_offset
  407.  
  408. : TOC_CALL
  409.     curr_TOC_offset  postpone literal  postpone (TOC_call)
  410.     4 ++> curr_TOC_offset  ;                immediate
  411.  
  412.  
  413.  
  414. : %_GetSharedLibrary
  415.     6 1  TOC_call  ;            immediate
  416.  
  417. : %_FindSymbol
  418.     4 1  TOC_call  ;            immediate
  419.  
  420. ¥ there's no %_Debugger - we don't want regs monkeyed with when we call it!
  421.  
  422. 12 -> curr_TOC_offset            ¥ leave room for entry point function descriptor
  423.  
  424. : %_NewHandleClear
  425.     1 1  TOC_call  ;        immediate
  426.  
  427. : %_NewPtrClear
  428.     1 1  TOC_call  ;        immediate
  429.  
  430. : %_MoveHHi
  431.     1 0  TOC_call  ;        immediate
  432.     
  433. : %_HLock
  434.     1 0  TOC_call  ;        immediate
  435.  
  436. : %_MakeDataExecutable
  437.     2 0  TOC_call  ;        immediate
  438.  
  439. : %_BlockMove
  440.     3 0  TOC_call  ;        immediate
  441.  
  442. : %_ExitToShell
  443.     0 0  TOC_call  ;        immediate
  444.  
  445. : %_InitGraf
  446.     1 0  TOC_call  ;        immediate
  447.  
  448. : %_InitFonts
  449.     0 0  TOC_call  ;        immediate
  450.  
  451. : %_InitWindows
  452.     0 0  TOC_call  ;        immediate
  453.  
  454. : %_TeInit
  455.     0 0  TOC_call  ;        immediate
  456.  
  457. : %_InitMenus
  458.     0 0  TOC_call  ;        immediate
  459.  
  460. : %_InitCursor
  461.     0 0  TOC_call  ;        immediate
  462.  
  463. : %_AEInstallEventHandler
  464.     5 1  TOC_call  ;        immediate
  465.  
  466. : %_GetNewWindow
  467.     3 1  TOC_call  ;        immediate
  468.     
  469. : %_SetPort
  470.     1 0  TOC_call  ;        immediate
  471.  
  472. : %_NewRgn
  473.     0 1  TOC_call  ;        immediate
  474.     
  475. : %_TextMode
  476.     1 0  TOC_call  ;        immediate
  477.  
  478. : %_SysBeep
  479.     1 0  TOC_call  ;        immediate
  480.  
  481.  
  482. : %_MaxApplZone
  483.     0 0  TOC_call  ;        immediate
  484.  
  485.  
  486. : INIT_RELOCS
  487.     $ 00010000    +L: relocs        ¥ sect 1 relocs
  488.     2            +L: relocs        ¥ 2 of them - is this right??
  489.     0            +L: relocs        ¥ relocs offs = 0
  490.  
  491.     $ 4A00  #imported_symbols 1- or
  492.                 +W: relocs        ¥ SYMR n - TOC entries for our n imported symbols
  493.     $ 4600        +W: relocs        ¥ DSC2 1 - maybe should be DATA 1?  check.
  494.                                 ¥  This should be for the entry funct descriptor
  495. ;
  496.  
  497.  
  498. (* INIT_CODE_SECTION initializes the code section.  code_start and code_size
  499.    are already set up.  We just have to initialize the extra info block.  We
  500.    can put whatever we need in this block.  It starts straight after the initial
  501.    branch, at code_start + 4.  Its size is given by the constant info_block_size ,
  502.    so if we add extra fields, remember to adjust the constant.  It gets
  503.    used by GO to allot the space at the beginning of the code section before
  504.    PPC compilation starts.
  505.    
  506.    Here's the format of the info block - note that this MUST AGREE with
  507.    what setup expects!
  508.    
  509.     4 bytes        code size
  510.     4 bytes        data size
  511.     4 bytes        displacement from code_start to nuc_code_start
  512.                     (i.e. code generator code size)
  513.     4 bytes        displacement from data_start to nuc_data_start
  514.                     (i.e. code generator data size)
  515.     32 bytes    initial CONTEXT
  516.     4 bytes        flags - always zero (default) in target compilation
  517.     12 bytes    spare
  518.     
  519.     Total: 64 bytes.
  520. *)
  521.  
  522. variable    dummy_len
  523.  
  524.  
  525. : FIX_THREAD  { thread# ¥ thread_addr lfa -- }
  526.  
  527.     thread# dummy_len c!                ¥ fake a "length byte" for THREAD
  528.     dummy_len thread  -> thread_addr    ¥ addr of thread start in CONTEXT
  529.     
  530.     thread_addr displace  -> lfa        ¥ addr of first link field in thread,
  531.                                         ¥  in CONTEXT
  532.     lfa
  533.     code_start 20 + thread# 4* +
  534.     displ!                                ¥ store in new CONTEXT
  535.     BEGIN
  536.         lfa displace                    ¥ chain back
  537.         dup code_start u<
  538.         IF    drop        ¥ next link field is below start of code
  539.                         ¥ - save orig, then kill link            
  540.             lfa @ +L: $threads  lfa +L: $threads
  541.             0 lfa !  EXIT
  542.         THEN
  543.         -> lfa
  544.     AGAIN
  545. ;
  546.  
  547.  
  548. : ADD_CONTEXT
  549.     new: $threads                        ¥ init string to save orig threads
  550.     #threads  FOR  i fix_thread  NEXT
  551. ;
  552.  
  553.  
  554. : RESTORE_THREADS
  555.     reset: $threads
  556.     BEGIN    len: $threads
  557.     WHILE    nxtL: $threads  ( orig link )  nxtL: $threads ( where it went )  !
  558.     REPEAT
  559.     release: $threads
  560. ;
  561.  
  562.  
  563. : INIT_CODE_SECTION
  564.     code_size    code_start  4 + !            ¥ code size
  565.     data_size    code_start  8 + !            ¥ data size
  566.     nuc_code_start code_start -
  567.                 code_start 12 + !            ¥ displ to nuc_code_start
  568.     nuc_data_start data_start -
  569.                 code_start 16 + !            ¥ offset to last extern
  570.     add_context                                ¥ adds 32 bytes
  571. ;
  572.  
  573.  
  574. : INIT_DATA_SECTION
  575. ;        ¥ data_start and data_size are set up already
  576.  
  577. : INIT_LOADER_SECTION
  578.     init_import_sym_tbl
  579.     init_relocs
  580. ;
  581.  
  582.  
  583. : SET_OFFSETS  { ¥ relocsOffs stringsOffs hashSlotTblOffs -- }
  584.  
  585.     0 -> container_offs
  586.     $ 80  -> ldr_offs
  587.  
  588.     length: loader_header
  589.     #align4  length: import_files_subsection  +
  590.     #align4  size: ldr_import_sym_tbl  +
  591.     #align4  12 +                ¥ reloc header is always 12 bytes
  592.     dup -> relocsOffs
  593.     size: relocs  12 - +        ¥ we've counted the reloc header already
  594.     #align4  dup -> stringsOffs
  595.     size: loader_strings +
  596.     #align4  dup -> hashSlotTblOffs
  597.     -> ldr_size    
  598.  
  599.     relocsOffs stringsOffs hashSlotTblOffs
  600.     1 ( data section )
  601.     #imported_symbols
  602.     init: loader_header
  603.  
  604.     ldr_offs ldr_size + #align16  -> code_offs
  605.     code_offs code_size + #align16  -> data_offs
  606.     
  607.     0 >kind: code_sect_hdr
  608.     1 >kind: data_sect_hdr
  609.     4 >kind: loader_sect_hdr
  610.     
  611.     code_offs code_size  init: code_sect_hdr
  612.     data_offs data_size  init: data_sect_hdr
  613.     ldr_offs  ldr_size   init: loader_sect_hdr
  614. ;
  615.  
  616.  
  617. res+    srcres
  618. res+    dstres
  619.  
  620.  
  621. syscall CreateResFile
  622. syscall    OpenResFile
  623. syscall CloseResFile
  624.  
  625.  
  626. : add_resources  { ¥ refNo -- }
  627.  
  628. ¥ First we add the 'cfrg' resource:
  629.  
  630.     getName: outpf  str255
  631.     CreateResFile  chk
  632.     buf255  OpenResFile  -> refNo  chk
  633.     new: $cfrg
  634.     my_cfrg  length: my_cfrg  add: $cfrg
  635.     size: $cfrg  getName: outpf nip +  $ 1D -    ¥ len of info record section
  636.     +W: $cfrg
  637.     getName: outpf  dup +c: $cfrg  add: $cfrg
  638.     $cfrg @  dstres !        ¥ both are subclassed from Handle!
  639.     'type cfrg  0  set: dstres
  640.     nullOSstr  addRes: dstres  chk
  641.     
  642.     'type WIND  256  copyRes        ¥ copy fWind (WIND 256)
  643.     'type BNDL  129  copyRes        ¥ and the BNDL
  644.     133 128 DO                        ¥ and the FREFs, icl8's and ICN#s
  645.         'type FREF  i  copyRes        ¥  (128 - 132)
  646.         'type icl8  i  copyRes
  647.         'type ICN#  i  copyRes
  648.     LOOP
  649.     'type ics8  128  copyRes        ¥ and ics8 128
  650.     'type SIZE  -1     copyRes        ¥ and SIZE -1
  651.  
  652. ¥ Now we create the new version resource which has a "type" that is the
  653. ¥ same as the sig, and ID 0.
  654.  
  655.     'type Mopp  0  set: dstRes
  656.     " interim"  dup 1+ align  new: dstRes
  657.     str255  ptr: dstRes  over  c@ 1+ cMove
  658.     nullOSstr  addRes: dstRes
  659.  
  660.     refNo CloseResFile  ;
  661.  
  662. ¥ note we mustn't release: $cfrg since the handle now belongs to the
  663. ¥ Resource Manager!
  664.  
  665.  
  666. : WRITE_PEF
  667.     create_outpf?  0EXIT
  668.  
  669.     code_limit  code_start -  -> code_size
  670.     data_limit  data_start -  -> data_size
  671.  
  672.     cr
  673.     ." code size (hex): "  code_size .h  cr
  674.     ." data size (hex): "  data_size .h  cr
  675.  
  676.     init_code_section
  677.     init_data_section
  678.     init_loader_section
  679.     set_offsets
  680.     setTimeStamp: PEF_header
  681.  
  682. ¥ write PEF header:
  683.     PEF_header            write_obj
  684.     code_sect_hdr        write_obj
  685.     data_sect_hdr        write_obj
  686.     loader_sect_hdr        write_obj
  687.     
  688.     pad_bytes 4  write_to_container            ¥ dummy global symbol table
  689.  
  690. ¥ loader section:
  691.     loader_header                write_obj
  692.     import_files_subsection        write_obj
  693.     all: ldr_import_sym_tbl        write_to_container
  694.     all: relocs                    write_to_container
  695.     all: loader_strings            write_to_container
  696.  
  697. ¥ code section:
  698.     16 align_in_container
  699.     code_start  code_size        write_to_container
  700.     
  701. ¥ data section:
  702.     16 align_in_container
  703.     data_start  data_size        write_to_container
  704.  
  705.     release: ldr_import_sym_tbl
  706.     release: relocs
  707.     release: loader_strings
  708.  
  709.     close: outpf drop
  710.     add_resources
  711.     restore_threads
  712. ;
  713.  
  714.  
  715. :f I/O_err
  716.     ." I/O err " .  cr
  717.     close: outpf drop
  718. ;f
  719.